(ns json-ext
  (:import [java.io PushbackReader StringReader EOFException]))

;;; This is JSON reader, with additional JavaScript supports:
;;; * Support single quoted string: 'hello'
;;; * Support bare word in object: {days: 365}
;;; * Support empty element in array: [1,,3]
;;; * Support undefined
;;; * Support variables: (binding [*variables* {"days": 365}] "[days]")
;;; * Support octal and hexadecimal
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;(set! *warn-on-reflection* true)

(def ^:dynamic *constants* {"true" true
                            "false" false
                            "null" nil
                            "undefined" nil})

(def ^:dynamic *variables* {})

(defn- eof
  ([message]
    (throw (EOFException. message)))
  ([]
    (eof "EOF when parsing JSON")))

(defn- badc
  ([message c]
    (throw (Exception. (format message c))))
  ([c]
    (badc "Unexpected char %c" c)))

(defn- ^Character readc [^PushbackReader stream]
  (let [i (.read stream)]
    (if (= i -1)
      (eof)
      (char i))))

(defmacro nexti []
  `(recur (.read ~'stream))) ; XXX: trick: ~'stream

(defmacro nextc [& args]
  `(recur (readc ~'stream) ~@args)) ; XXX: trick: ~'stream

(defn- skip-blanks [^PushbackReader stream]
  (loop [i (.read stream)]
    (cond
      (= i -1) stream
      (Character/isWhitespace (char i)) (nexti)
      :else (do
              (.unread stream i)
              stream))))

(defn- stream-str [^PushbackReader stream]
  (let [sb (StringBuilder.)]
    (loop [i (.read stream)]
      (if (= i -1)
          (.toString sb)
          (do (.append sb (char i)) (nexti))))))

(declare read-json-value)

;; TODO: support negative number, floating number, octal, hexadecimal, exp, 2., .2, ...
(defn- read-json-number [^PushbackReader stream]
  (let [sb (StringBuilder.)]
    (loop [i (.read stream)]
      (let [c (char i)]
        (cond
          (= i -1) (if (zero? (.length sb))
                       (eof "EOF when parsing JSON number")
                       (Integer/parseInt (.toString sb)))
          (Character/isDigit c) (do (.append sb c) (nexti))
          :else (do
                  (.unread stream i)
                  (if (zero? (.length sb))
                      (eof "EOF when parsing JSON number")
                      (Integer/parseInt (.toString sb)))))))))

;; TODO: remove ratio support, add support for 2. and .2
;; FIXME: {1:3} fails
(defn- read-json-number [^PushbackReader stream]
  (read stream true nil))

(defn- read-json-string [^PushbackReader stream q]
  (let [sb (StringBuilder.)]
    (loop [c (readc stream)]
      (cond
        (= c q) (.toString sb)
        (= c \\) (let [c (readc stream)]
                   (cond
                     (= c \") (do (.append sb \") (nextc))
                     (= c \') (do (.append sb \') (nextc))
                     (= c \\) (do (.append sb \\) (nextc))
                     (= c \/) (do (.append sb \/) (nextc))
                     (= c \b) (do (.append sb \backspace) (nextc))
                     (= c \f) (do (.append sb \formfeed) (nextc))
                     (= c \n) (do (.append sb \newline) (nextc))
                     (= c \r) (do (.append sb \return) (nextc))
                     (= c \t) (do (.append sb \tab) (nextc))
                     (= c \u) (let [ssb (StringBuilder. 4)]
                                  (dotimes [i 4] (.append ssb (readc stream)))
                                  (.append sb (char (Integer/parseInt (.toString ssb) 16)))
                                  (nextc))
                     :else (badc "Invalid escaping char %c" c)))
        :else (do (.append sb c) (nextc))))))

(defn- read-json-identifier [^PushbackReader stream]
  (let [sb (StringBuilder.)]
    (loop [i (.read stream)]
      (let [c (char i)]
        (cond
          (= i -1) (if (zero? (.length sb))
                       (eof "EOF when parsing JSON identifier")
                       (.toString sb))
          (Character/isJavaIdentifierPart c) (do (.append sb c) (nexti))
          :else (do
                  (.unread stream i)
                  (if (zero? (.length sb))
                      (eof "EOF when parsing JSON identifier")
                      (.toString sb))))))))

(defn- read-json-variable [^PushbackReader stream]
  (let [name (read-json-identifier stream)
        bindings (merge *variables* *constants*)]
    (if (contains? bindings name)
        (get bindings name)
        (throw (Exception. (str "Unbound varaible " name))))))

(defn- read-json-constant [^PushbackReader stream]
  (let [name (read-json-identifier stream)]
    (if (contains? *constants* name)
        (get *constants* name)
        (throw (Exception. (str "Unknown lexical " name))))))

(defn- read-json-array [^PushbackReader stream]
  (loop [c (readc stream) a [] just false]
    (cond
      (Character/isWhitespace c) (nextc a just)
      (= c \]) a
      (= c \,) (if just
                   (nextc a false)
                   (nextc (conj a nil) false))
      :else (do
              (.unread stream (int c))
              (let [v (read-json-value stream)]
                (nextc (conj a v) true))))))

(defn- read-json-property-id [^PushbackReader stream]
  (loop [i (.read stream)]
    (let [c (char i)]
      (cond
        (= i -1) (throw (EOFException. "EOF when parsing JSON value"))
        (Character/isWhitespace c) (recur (.read stream))
        (= c \") (read-json-string stream \")
        (= c \') (read-json-string stream \')
        (#{\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9} c) (do (.unread stream i) (str (read-json-number stream)))
        (Character/isJavaIdentifierStart c) (do (.unread stream i) (read-json-identifier stream))
        :else (throw (Exception. (format "Unexpected char: %c" c)))))))

;; FIXME: {[]:2} should be invalid
(defn- read-json-object [^PushbackReader stream]
  (loop [c (readc stream) m {} just false]
    (cond
      (Character/isWhitespace c) (nextc m just)
      (= c \}) m
      (= c \,) (if just
                   (nextc m false)
                   (badc \,))
      :else (do
              (when just (throw (Exception. "Expect , or }")))
              (.unread stream (int c))
              (let [k (read-json-property-id stream)]
                (skip-blanks stream)
                (when-not (= (readc stream) \:)
                  (throw (Exception. "Expected ':'")))
                (let [v (read-json-value stream)]
                  (nextc (assoc m k v) true)))))))

(defn- read-json-value [^PushbackReader stream]
  (loop [i (.read stream)]
    (let [c (char i)]
      (cond
        (= i -1) (throw (EOFException. "EOF when parsing JSON value"))
        (Character/isWhitespace c) (recur (.read stream))
        (= c \") (read-json-string stream \")
        (= c \') (read-json-string stream \')
        (= c \[) (read-json-array stream)
        (= c \{) (read-json-object stream)
        (#{\- \0 \1 \2 \3 \4 \5 \6 \7 \8 \9} c) (do (.unread stream i) (read-json-number stream))
        (Character/isJavaIdentifierStart c) (do (.unread stream i) (read-json-variable stream))
        :else (throw (Exception. (format "Unexpected char: %c" c)))))))



(defn read-json [s]
  (let [stream (PushbackReader. (StringReader. s))
        v (read-json-value stream)]
    (let [left (stream-str (skip-blanks stream))]
      (when (not= left "")
        (throw (Exception. (str "Unexpected " left)))))
    v))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;(time (dotimes [i 100000] (read-json "{\"name\":\"s\",\"value\":\"a\",\"values\":[1,2,34]}")))
